home *** CD-ROM | disk | FTP | other *** search
/ Gekkan Dennou Club 147 / Gekkan Dennou Club - 2000.8 Vol. 147 (Japan).7z / Gekkan Dennou Club - 2000.8 Vol. 147 (Japan) (Track 1).bin / ikap / snd3 / cvts.pas < prev    next >
Pascal/Delphi Source File  |  2000-07-03  |  2KB  |  86 lines
  1. (*
  2. /.DEFINE Ａ % {
  3. /    l16  |:4 %*10 r*2 %*22 r*2 _3 :| ~12 %*22 r*2   %8*22 r*2
  4. /    }
  5. /.DEFINE Ｄ % {
  6. /    l16  |:2 %*10 r*2 %*22 r*2 _3 :|  ~3 %*10 r*2 ~3 %*10 r*2
  7. /    }
  8. /.DEFINE Ｆ % {
  9. /    l16  %*10 r*2 %*22 r*2
  10. /    }
  11. /.DEFINE ＜ {>}
  12. /.DEFINE ＞ {<}
  13. *)
  14.  
  15. procedure cvt(s:string);
  16.   var
  17.     i:word;
  18.   procedure cvts(ss:string);
  19.     var
  20.       ts:string;
  21.       x:word;
  22.     begin
  23.       s:=s+' | ';
  24.      {writeln('SS=',ss);
  25.       writeln('i=',i);
  26.         writeln(byte(s[0]),'|',i,'S=',S);}
  27.       inc(i,2);
  28.       while(s[i]=' ') do inc(i);
  29.       ts:='';
  30.       while s[i]<>' ' do begin ts:=ts+s[i]; inc(i); end;
  31.       
  32.      {if ts='f#＜Ｄ' then begin
  33.         ts:='f#';
  34.       end;}
  35.       for x:=1 to word(ss[0]) do begin
  36.         if ss[x]<>'%' then write(ss[x]) else write(ts);
  37.       end;
  38.       writeln;
  39.       dec(s[0],3);
  40.     end;
  41.   
  42.   begin
  43.    {writeln('2S=',S);}
  44.     i:=1;
  45.     while i<=word(s[0]) do begin
  46.       if copy(s,i,2)='Ａ' then begin
  47.        {writeln(byte(s[0]),'|',i,'S=',S);}
  48.         cvts('l16  |:4 %*10 r*2 %*22 r*2 _3 :| ~12 %*22 r*2   %8*22 r*2')
  49.       end
  50.       else
  51.       if copy(s,i,2)='Ｄ' then begin
  52.         cvts('l16  |:2 %*10 r*2 %*22 r*2 _3 :|  ~3 %*10 r*2 ~3 %*10 r*2')
  53.       end
  54.       else
  55.       if copy(s,i,2)='Ｆ' then begin
  56.         cvts('l16  %*10 r*2 %*22 r*2')
  57.       end
  58.       else
  59.       if copy(s,i,2)='＜' then begin
  60.         write('>'); inc(i,2);
  61.       end
  62.       else
  63.       if copy(s,i,2)='＞' then begin
  64.         write('<'); inc(i,2);
  65.       end
  66.       else begin
  67.         write(s[i]); inc(i);
  68.       end;
  69.      {writeln(byte(s[0]),'|',i,'S=',S);}
  70.     end;
  71.     writeln;
  72.   end;
  73.  
  74. var
  75.   f:text;
  76.   s:string;
  77. begin
  78.   assign(f,'or172m.s');
  79.   reset(f);
  80.   while not eof(f) do begin
  81.     readln(f,s);
  82.     cvt(s);
  83.   end;
  84.   close(f);
  85. end.
  86.